(*
  Copyright (c) 2009 Barry Schwartz

  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
  files (the "Software"), to deal in the Software without
  restriction, including without limitation the rights to use,
  copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following
  conditions:

  The above copyright notice and this permission notice shall be
  included in all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  OTHER DEALINGS IN THE SOFTWARE.
*)

type bitmap =
  { bm_width : int; bm_height : int; bm_bytes_per_row : int; bm_data : string
  }

let make width height =
  {
    bm_width = width;
    bm_height = height;
    bm_bytes_per_row = (width + 7) / 8;
    bm_data = String.make (((width + 7) / 8) * height) '\000';
  }
  
let get_index bm x y = (y * bm.bm_bytes_per_row) + (x / 8)
  
let get_bit x = 1 lsl (7 - (x land 7))
  
let unsafe_point bm x y =
  let i = get_index bm x y
  in ((Char.code bm.bm_data.[i]) land (get_bit x)) <> 0
  
let unsafe_set_point bm x y =
  let i = get_index bm x y
  in
    bm.bm_data.[i] <-
      Char.unsafe_chr ((Char.code bm.bm_data.[i]) lor (get_bit x))
  
let unsafe_unset_point bm x y =
  let i = get_index bm x y
  in
    bm.bm_data.[i] <-
      Char.unsafe_chr ((Char.code bm.bm_data.[i]) land (lnot (get_bit x)))
  
let point bm x y =
  if (0 <= x) && ((x < bm.bm_width) && ((0 <= y) && (y < bm.bm_height)))
  then unsafe_point bm x y
  else false
  
let set_point bm x y =
  if (0 <= x) && ((x < bm.bm_width) && ((0 <= y) && (y < bm.bm_height)))
  then unsafe_set_point bm x y
  else ()
  
let unset_point bm x y =
  if (0 <= x) && ((x < bm.bm_width) && ((0 <= y) && (y < bm.bm_height)))
  then unsafe_unset_point bm x y
  else ()
  
let set_line bm x1 x2 y =
  for x = max x1 0 to min x2 (bm.bm_width - 1) do unsafe_set_point bm x y
  done
  
let unset_line bm x1 x2 y =
  for x = max x1 0 to min x2 (bm.bm_width - 1) do unsafe_set_point bm x y
  done
  
let copy_line bm y1 y2 =
  if (0 <= y1) && ((y1 < bm.bm_height) && ((0 <= y2) && (y2 < bm.bm_height)))
  then
    for x = 0 to bm.bm_width - 1 do
      if unsafe_point bm x y1
      then unsafe_set_point bm x y2
      else unsafe_unset_point bm x y2
    done
  else ()
  
let print io bm black white end_line =
  let rec iter x y =
    if y >= bm.bm_height
    then ()
    else
      if x >= bm.bm_width
      then (IO.write_string io end_line; iter 0 (y + 1))
      else
        (if unsafe_point bm x y
         then IO.write_string io black
         else IO.write_string io white;
         iter (x + 1) y)
  in iter 0 0
  

